package Bio::Tools::Mlst;

use base qw(Bio::Tools::MlstI);
use 5.008008;
use strict;
use warnings;
use Data::Dumper;

#our $VERSION = '0.5';

sub new{
  my($class,$args)=@_;
  my $self={
  };
  bless($self, $class);
  
  #if site is defined, it can overwright repository
  #However, repository is the preferred variable
  if($$args{site}){ # site is an alias to repository
    $$args{repository}=$$args{site};
  }
  my $repository=$self->_pickRepository($args);
  $self->_setDefaultArguments($args);
  
  # Return an object that is specific for the repository
  if($repository eq 'pubmlst'){
    use Bio::Tools::Mlst::PubMLST;
    return Bio::Tools::Mlst::PubMLST->new($args);
  }
  elsif($repository eq 'mlstnet'){
    use Bio::Tools::Mlst::Mlstnet;
    return Bio::Tools::Mlst::Mlstnet->new($args);
  }
  # http://mlst.ucc.ie/
  elsif($repository eq 'ucc'){
    use Bio::Tools::Mlst::Ucc;
    return Bio::Tools::Mlst::Ucc->new($args);
    #$self->throw_not_implemented();
  }
  # http://www.shigatox.net/ecmlst/cgi-bin/index
  elsif($repository eq 'ecmlst'){
    $self->throw_not_implemented();
  }
  # http://www.pasteur.fr/recherche/genopole/PF8/mlst/EColi.html
  elsif($repository eq 'pasteur'){
  	$self->throw_not_implemented();
  }
  else{
    $self->_error("Could not determine the correct repository for your database $$args{database}\n");
  }
  
  return $self;
}

########## private functions #############
# trim whitespace on either end of a string
sub _trim{
  my($str)=shift;
  $str=~s/^\s+|\s+$//g;
  return $str;
}
sub _error{
  my($self,$errorObj)=@_;
  $self->_throw($errorObj,"error");
}
sub _warn{
  my($self,$errorObj)=@_;
  $self->_throw($errorObj,"warn");
}
# throwing an error, MLST-style.
# $errorObj can be a string or object
# $todo can be "error" or "warn" or empty string
sub _throw{
  my($self,$errorObj,$todo)=@_;
  # generate the error string
  my $error; # the string of the error thrown
  if($errorObj->isa('SOAP::SOM')){
    $error=join ', ',$errorObj->faultcode,$errorObj->faultstring;
  }
  else{
    $error=$errorObj;
  }
  # now, do something with the error string
  $todo=$todo||"error"; # give default value for $todo
  if($todo eq "error"){
    $self->throw($error);
  }
  elsif($todo eq "warn"){
    #my $prevVerbosity=$self->verbose(1); # stack trace
    $self->verbose(1); # stack trace
    $self->warn($error);
    #$self->verbose($prevVerbosity); # set the verbosity back to whatever
  }
}
# for specified keys, set them as default arguments
# which will be included in every $args
sub _setDefaultArguments{
  my($self,$args)=@_;
  my %defaultArgs=();
  # these default arguments should include just about anything
  my @argsKeys=qw(repository database locus allele ST);
  my $numKeys=@argsKeys;
  for(my $i=0;$i<$numKeys;$i++){
    if(defined($$args{$argsKeys[$i]})){
      $defaultArgs{$argsKeys[$i]}=$$args{$argsKeys[$i]};
    }
  }
  
  $self->{defaultArgs}=\%defaultArgs;
}
########## file IO ###########
# create a temporary directory if it doesn't already exist
sub _tempDir{
  use File::Temp;
  use File::Basename;
  my($self)=@_;
  # if it already exists, return the temp directory
  if(defined $self->{tempDir}){
    return $self->{tempDir};
  }
  # create a temp directory
  my $dir=File::Temp->tempdir("perlMlstXXXXXX",CLEANUP=>1); # temporary directory
  $self->{tempDir}=$dir;
  
  # Ok, this is a sly place to get the directory separator.
  # Get the directory separator
  my($filename, $directories, $suffix) = fileparse($dir);
  $self->{dirSeparator}='/'; # UNIX/LINUX by default
  if($directories=~/\\/){ # windows
    $self->{dirSeparator}='\\';
  }
  else{                   # UNIX/LINUX
    $self->{dirSeparator}='/';
  }
  
  return $dir;
}
# write a temp file, given a filename and contents
sub _writeTempFile{
  my($self,$args)=@_;
  my $filename=$$args{'filename'}||$$args{'file'};
  my $path=$self->_tempDir.'/'.$filename;
  open(FILE,">$path") or die("Could not open temporary file $filename for writing because $!");
  print FILE $$args{'content'};
  close FILE;
  return $path;
}
# read a temp file, given a filename
sub _readTempFile{
  my($self,$args)=@_;
  my($filename)=$$args{'filename'}||$$args{'file'};
  my $path=$self->_tempDir.'/'.$filename;
  open(FILE,$path) or die("Could not open temporary file $filename for reading because $!");
  my @content=<FILE>;
  close FILE;
  return join("",@content);
}
# check to see if a temp file exists
sub _tempFileExists{
  my($self,$args)=@_;
  $args=$self->_processArgs($args);
  #print "file exists sub: ".Dumper $args;exit;
  my($filename)=$$args{'filename'}||$$args{'file'};
  my $path=$self->_tempDir.'/'.$filename;
  if(-e $path){
    return 1;
  }
  return 0;
}

# manipulate the arguments every which way for all subroutines
sub _processArgs{
  my($self,$args)=@_;
  
  # add in the default arguments
  my($defaultArgs)=$self->{defaultArgs};
  foreach my $key (keys %$defaultArgs){
    if(defined($$defaultArgs{$key})
     &&!defined($$args{$key})){
      $$args{$key}=$$defaultArgs{$key};
    }
  }
  
  # aliases
  if($$args{site}){
    $$args{repository}=$$args{site};
  }
  
  # Exact match should be defined.
  # This is the number of loci that must be matched in a given subroutine.
  if(!defined($$args{exactMatch})){
    $$args{exactMatch}=7; # this might have to change if the total loci are not 7 in the organism
  }
  # force exact match to boolean
  $$args{exactMatch}=$self->_toBoolean($$args{exactMatch});
  
  # standardize the locus argument's value
  if($$args{locus}){
    $$args{locus}=$self->_locusToFourLetters($$args{locus});
  }
  
  return $args;
}
# there should be a better way to do this
sub _toBoolean{
  my($self,$value)=@_;
  my $return=$value;
  my $v=lc($value); # lc for the string comparison below
  if($v eq 'true'
   ||$v eq 1
    ){
    $return=1;
  } elsif($v eq 'false'
   ||$v eq 0 
    ){
    $return=0;
  }
  return $return;
}

######## some pubmlst functions #############
sub _pubmlstSoap{
  use SOAP::Lite;
  my $pubmlstSoap = SOAP::Lite
    -> uri('http://pubmlst.org/MLST')
    -> proxy('http://pubmlst.org/cgi-bin/mlstdbnet/mlstFetch.pl');
  #$pubmlstSoap->transport->timeout(120); # set the timeout to xx seconds
  return $pubmlstSoap;
}
sub _getPubmlstDatabaseList{
  my($self,$args)=@_;
  my $soapResponse = $self->_pubmlstSoap->getDatabaseList();
  my @databases;
  unless ($soapResponse->fault){
    @databases=$soapResponse->valueof('//database');
  } else {
    $self->_error($soapResponse);
  }
  return @databases;
}
####### mlstnet functions ##########
sub _getMlstnetDatabaseList{
  my($self,$args)=@_;
  # TODO get the list directly from the website or from a centralized source
  my @mlstnetList=qw(spneumoniae borrelia bpseudomallei calbicans cglabrata
                     cneoformans efaecalis efaecium haemophilus leptospira
                     saureus sepidermidis spyogenes ssuis);
  return @mlstnetList;
}
########## UCC functions ###########
sub _getUccDatabaseList{
  my($self,$args)=@_;
  # TODO get the list directly from the website or from a centralized source
  my @uccList=qw(ecoli mcatarrhalis senterica ypseudotuberculosis);
  return @uccList;
}
######### repository functions ###########
#repository hash (which repository for the given database [e.g. neisseria]?
sub _repositoryHash{
  my($self,$args)=@_;
  #TODO check if $self->repositoryHash exists and return that if possible
  my (%repositoryHash);
  
  # get the pubmlst list
  my @pubmlstList=$self->_getPubmlstDatabaseList();
  for(my $i=0;$i<@pubmlstList;$i++){
    $repositoryHash{$pubmlstList[$i]{'name'}}='pubmlst';
  }
  
  # add in www.mlst.net
  my @mlstnetList=$self->_getMlstnetDatabaseList();
  for(my $i=0;$i<@mlstnetList;$i++){
    $repositoryHash{$mlstnetList[$i]}='mlstnet';
  }
  
  # UCC list of databases
  my @uccList=$self->_getUccDatabaseList();
  for(my $i=0;$i<@uccList;$i++){
    $repositoryHash{$uccList[$i]}='ucc';
  }
  
  #TODO add in any other repositories?
  
  $self->{repositoryHash}=\%repositoryHash;
  return %repositoryHash;
}
# given a database, return the name of the repository
sub _pickRepository{
  my($self,$args)=@_;
  if($$args{repository}){
    return $$args{repository};
  }
  my %repositoryHash=$self->_repositoryHash();
  #TODO check to see if the database exists in the hash.
  # if not, supply a default one--pubmlst
  my $r=$repositoryHash{$$args{database}};
  $$args{repository}=$r;
  return $r;
}
# get the possible repository names for this module
# Should this be private?  Would this ever be publically used?
sub _repositoryNames{
  my($self,$args)=@_;
  my %repositoryHash=$self->_repositoryHash();
  my @name=values(%repositoryHash);
  return @name;
}

###### shortcut bioperl subroutines ########
# TODO use either/both _locusToFourLetters and _locusTrimUnderscores
# to translate locus names between the site and module. 
# convert a 1, 2, or 3-letter gene to 4-letter gene notation
sub _locusToFourLetters{
  my($self,$name)=@_;
  # fill up the length of the gene up to 4
  while(length($name)<4){
    $name.="_";
  }
  # check and see if the locus has more than 4 letters
  if(length($name)>4){
    $name=$self->_locusTrimUnderscores($name);
    if(length($name)>4){
      warn("Warning: The locus $name is longer than 4 characters, which is an odd gene name.");
    } 
  }
  return $name;
}
# remove trailing underscores from a gene name
sub _locusTrimUnderscores{
  my($self,$name)=@_;
  $name=~s/_+$//;
  return $name;
}
# convert a string sequence to a SeqIO object
sub _sequenceToSeqIO{
  use Bio::SeqIO;
  my($self,$sequence)=@_;
  my $seqio;
  
  my $ref=ref($sequence); # what kind of variable is $sequence?
  if($ref eq ""){ # string  
    # if the sequence is just ATCG (and/or whitespace), then add a defline
    $sequence=~s/^\s+|\s+$//g;
    if($sequence=~/[ATCG\s]+/i){
  	  $sequence=">sequence\n".$sequence;
      my $fh=new IO::String(\$sequence);
      $seqio=Bio::SeqIO->new(-fh=>$fh);
    }
  }
  elsif($ref eq "HASH"){ # object
    $self->throw_not_implemented();
  }
  return $seqio;
}

1;
__END__

=head1 NAME

MLST - Perl extension for pubmlst.org's API.
Most subroutines were adopted from Keith Jolley's 
scripts found at pubmlst.org/api

=head1 SYNOPSIS

  # get a sequence from PubMLST
  use MLST;
  $mlst=MLST->new();
  $seq=$mlst->getAlleleSequence('neisseria','abcZ',5);
  print ">".$seq->id()."\n".$seq->seq
  
  # you can pass any default arguments when initializing
  # such as database or locus
  my $pubmlst=MLST->new({database=>$database});
  print Dumper $pubmlst->getAllele({database=>$database,locus=>$locus,allele=>$allele});
  print Dumper $pubmlst->blast({sequence=>$sequence,numresuls=>3});
  print Dumper $pubmlst->getAlleleCount({locus=>$locus});
  print Dumper $pubmlst->getAlleles({locus=>$locus});
  print Dumper $pubmlst->getAlleleSequencesURL({locus=>$locus});
  print Dumper $pubmlst->getClonalComplexes({});
  print Dumper $pubmlst->getDatabaseList();
  print Dumper $pubmlst->getIsolateCount();

=head1 DESCRIPTION

MLST is used for interfacing with pubmlst.org.  In the future, it 
should allow for interfacing with all MLST sites.



=head2 EXPORT

None by default.



=head1 SEE ALSO

http://pubmlst.org/api/

=head1 AUTHOR

Lee, <lt>lskatz@gatech.edu<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2009 by Lee Katz

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.


=cut
